home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue66 / Construc / Refactor / Source / uVersionInformation.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-11-06  |  3.8 KB  |  142 lines
  1. unit uVersionInformation;
  2. {
  3.   Copyright ⌐ 2000, Synature
  4.   Written by Brandon Smith
  5. }
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs;
  11.  
  12. type
  13.  
  14.   tMSResourceNameEnum = (msFileVersion, msProductVersion, msFileDescription, msCompanyName, msComments,
  15.                          msInternalName, msLegalCopyright, msLegalTrademarks, msProductName, msOriginalFilename);
  16.  
  17.   TVersionInformation = class
  18.   private
  19.     FName: string;
  20.     FLanguageIDString : string;
  21.     FLanguageID: DWord;
  22.     FLang: PInteger;
  23.     FLangNum: integer;
  24.     FVerInfo: pointer;
  25.     FVerInfoSize: longint;
  26.     fHasVerInfo: boolean;
  27.     fErrMsg: string;
  28.     procedure SetFileName(Value: string);
  29.     function GetValue(aName: string): string;
  30.     function getMsVerName(ndx: tMSResourceNameEnum): string;
  31.   public
  32.     //constructor Create(AOwner: TComponent); override;
  33.     //destructor Destroy; override;
  34.     class function instance : TVersionInformation;
  35.     property Values[aName : string] : string read GetValue;
  36.     property LanguageID: DWord read FLanguageID write FLanguageID;
  37.     Property LanguageIDString : string read FLanguageIDString write FLanguageIDString;
  38.     property FileName: string read FName write SetFileName;
  39.     Property MSVerNames[ndx : tMSResourceNameEnum] : string read getMsVerName;
  40.     Property HasVerInfo : boolean read fHasVerInfo;
  41.     Property ErrorMessage : string read fErrMsg;
  42.  
  43.   end;
  44.  
  45.  
  46. const
  47.   cUSEnglish = $040904E4;
  48.  
  49. var
  50.   VerInfo : TVersionInformation;
  51.  
  52. implementation
  53. uses TypInfo;
  54.  
  55. class function TVersionInformation.instance: TVersionInformation;
  56. begin
  57.   if not assigned(VerInfo)
  58.     then VerInfo := TVersionInformation.Create;
  59.   result := VerInfo;
  60. end;
  61.  
  62.  
  63. procedure TVersionInformation.SetFileName(Value: string);
  64. var
  65.   len: DWord;
  66. begin
  67.   fName := value;
  68.   if fVerInfoSize > 0
  69.     then begin
  70.       FreeMem(fVerInfo, fVerInfoSize);
  71.       fVerInfoSize := 0;
  72.       end;
  73.   if not FileExists(fname)
  74.     then begin
  75.       fErrMsg := 'File '+fname+' not found by version information object.';
  76.       fHasVerInfo := false;
  77.       exit;
  78.       end;
  79.   fVerInfoSize := GetFileVersionInfoSize(pchar(fname), len);
  80.   if fVerInfoSize > 0
  81.     then begin
  82.       fHasVerInfo := true;
  83.       GetMem(fVerInfo, fVerInfoSize);
  84.       if not GetFileVersionInfo(pchar(fname), len, fVerInfoSize, fVerInfo)
  85.         then begin
  86.           fErrMsg := 'Cannot retrieve Version Information for ' + fname;
  87.           fHasVerInfo := false;
  88.           end;
  89.       // get languages
  90.       VerQueryValue(fVerInfo, '\VarFileInfo\Translation', pointer(FLang), len);
  91.       if flang = nil
  92.         then begin
  93.           fErrMsg := 'No language pointer in version information for ' +fname;
  94.           fHasVerInfo := false;
  95.           end;
  96.       FLangNum := len div 4;
  97.       end
  98.     else begin
  99.         fErrMsg := 'Ver Info size call failed for '+fname;
  100.         fHasVerInfo := false;
  101.         end;
  102. end;
  103.  
  104.  
  105. const
  106.   queryFmt = '\StringFileInfo\%4.4x%4.4x\%s';
  107.  
  108. function TVersionInformation.GetValue(aName: string): string;
  109. var
  110.   ptr: pchar;
  111.   len: DWord;
  112. begin
  113.   Result := EmptyStr;
  114.   if fVerInfoSize <= 0
  115.     then begin
  116.       fErrMsg := 'VerInfo object not initialized for '+fname;
  117.       fHasVerInfo := false;
  118.       exit;
  119.       end;
  120.   if VerQueryValue(fVerInfo, pchar(Format(queryFmt, [LoWord(FLang^), HiWord(FLang^), aName])), pointer(ptr), len)
  121.     then Result := ptr;
  122. end;
  123.  
  124. function TVersionInformation.getMsVerName(
  125.   ndx: tMSResourceNameEnum): string;
  126. var  EnumType : PTypeInfo;
  127. begin
  128.   EnumType := TypeInfo(tMSResourceNameEnum);
  129.   result := GetEnumName(EnumType, ord(ndx) );
  130.   system.delete(result, 1, 2);
  131. end;
  132.  
  133. Initialization
  134.   VerInfo := TVersionInformation.create;
  135.   VerInfo.LanguageID := cUSEnglish;
  136.  
  137. Finalization
  138.   VerInfo.free;
  139.  
  140.  
  141. end.
  142.